home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic 4 Database How-To
/
Visual Basic 4 Database - How-to (The Waite Group)(1995).iso
/
select3.fr_
/
select3.fr
Wrap
Text File
|
1995-07-04
|
7KB
|
222 lines
VERSION 4.00
Begin VB.Form Form1
BackColor = &H00C0C0C0&
Caption = "Variable SELECTer"
ClientHeight = 4665
ClientLeft = 1770
ClientTop = 1860
ClientWidth = 7575
Height = 5070
Left = 1710
LinkTopic = "Form1"
ScaleHeight = 4665
ScaleWidth = 7575
Top = 1515
Width = 7695
Begin VB.TextBox txtYearPublished
Height = 285
Left = 6120
TabIndex = 3
Top = 1740
Width = 915
End
Begin VB.CommandButton cmdClose
Caption = "Close"
Default = -1 'True
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 555
Left = 3120
TabIndex = 2
Top = 3780
Width = 1335
End
Begin VB.ListBox lstTitles
Height = 1035
Left = 480
TabIndex = 1
Top = 2160
Width = 6555
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = "C:\VB\BIBLIO.MDB"
Exclusive = 0 'False
Height = 300
Left = 480
Options = 0
ReadOnly = 0 'False
RecordsetType = 2 'Snapshot
RecordSource = "SELECT [Company Name] FROM [Publishers] ORDER BY [Company Name]"
Top = 1800
Visible = 0 'False
Width = 2115
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00C0C0C0&
Caption = "Year Published:"
BeginProperty Font
name = "MS Sans Serif"
charset = 0
weight = 700
size = 8.25
underline = 0 'False
italic = 0 'False
strikethrough = 0 'False
EndProperty
Height = 195
Left = 4680
TabIndex = 4
Top = 1800
Width = 1350
End
Begin MSDBCtls.DBList dblPublishers
Bindings = "SELECT3.frx":0000
Height = 840
Left = 480
TabIndex = 0
Top = 360
Width = 5175
_Version = 65536
_ExtentX = 9128
_ExtentY = 1482
_StockProps = 77
BackColor = -2147483643
MatchEntry = 1
ListField = "Company Name"
BoundColumn = "Name"
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Change the following to point to your copy of BIBLIO.MDB.
Dim db As DATABASE
Private Sub Form_Load()
On Error GoTo FormLoadError
Dim dbName As String
' Get the database name and open the database.
dbName = BiblioPath() ' BiblioPath is a function in READINI.BAS
Set db = DBEngine.Workspaces(0).OpenDatabase(dbName)
Exit Sub
FormLoadError:
' Just display Visual Basic's default error message.
MsgBox Error(Err)
Exit Sub
End Sub
Private Sub dblPublishers_Click()
' Open a snapshot-type recordset on the [Titles] Table, selecting only
' those titles published by the selected publishing company and (if the
' user has entered a publication year) in the designated year. Sort the
' records by the ISBN number.
Dim rs As Recordset
Dim sql As String
Dim yrPublished As Integer
' Set up the error handler.
On Error GoTo PublishersClickError
' Clear any existing data in the Titles list box.
lstTitles.Clear
' Convert the text in txtYearPublished to a numeric value.
' If there is no text or if it is non-numeric, the value will be 0.
If IsNumeric(txtYearPublished) Then yrPublished = Val(txtYearPublished)
' Build the SQL statement.
sql = "SELECT [Title], [ISBN] FROM [Titles]"
' Call the function GetPubID(), which returns the PubID that
' corresponds to the currently selected item in dblPublishers.
sql = sql & " WHERE [PubID] = " & GetPubID()
' If the user entered a numeric value in the Year Published box,
' append that year to the WHERE clause as an additional criterion.
If yrPublished > 0 Then
sql = sql & " AND [Year Published] = " & yrPublished
End If
' Append the ORDER clause to the SQL statement.
sql = sql & " ORDER BY [ISBN]"
' Use the SQL statement as the recordset definition to open a titles
' recordset.
Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
' If there is at least one record in the recordset, move through the
' recordset a record at a time until the end of the file (EOF) is
' reached. Display each record in the unbound list box lstTitles.
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
lstTitles.AddItem rs![ISBN] & ": " & rs![Title]
rs.MoveNext
Loop
End If
Exit Sub
PublishersClickError:
' Just display Visual Basic's default error message.
MsgBox Error(Err)
Exit Sub
End Sub
Function GetPubID() As Long
Dim rs As Recordset
Dim sql As String
' Build the SQL statement.
sql = "SELECT [PubID] FROM [Publishers]"
' Use the text currently selected in the Publishers list box as the
' criterion for selecting a record from the Publishers table. Because
' the value being used as a criterion is a string (text) value, it
' must be delimited by double quotes.
sql = sql & " WHERE [Company Name] = """ & dblPublishers.TEXT & """"
' Use the SQL statement as the recordset definition to open a titles
' recordset.
Set rs = db.OpenRecordset(sql, dbOpenSnapshot)
' Return the value of the [PubID] field for the record found. If no
' record matched the criterion, return 0.
If rs.RecordCount > 0 Then
GetPubID = rs![PubID]
Else
GetPubID = 0
End If
End Function
Private Sub cmdClose_Click()
End
End Sub